home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / win / tclWinFCmd.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  38.3 KB  |  1,403 lines  |  [TEXT/CWIE]
  1. /*
  2.  * tclWinFCmd.c
  3.  *
  4.  *      This file implements the Windows specific portion of file manipulation 
  5.  *      subcommands of the "file" command. 
  6.  *
  7.  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclWinFCmd.c 1.19 97/08/05 15:23:47
  13.  */
  14.  
  15. #include "tclWinInt.h"
  16.  
  17. /*
  18.  * The following constants specify the type of callback when
  19.  * TraverseWinTree() calls the traverseProc()
  20.  */
  21.  
  22. #define DOTREE_PRED   1     /* pre-order directory  */
  23. #define DOTREE_POSTD  2     /* post-order directory */
  24. #define DOTREE_F      3     /* regular file */
  25.  
  26. /*
  27.  * Callbacks for file attributes code.
  28.  */
  29.  
  30. static int        GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  31.                 int objIndex, char *fileName,
  32.                 Tcl_Obj **attributePtrPtr));
  33. static int        GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
  34.                 int objIndex, char *fileName,
  35.                 Tcl_Obj **attributePtrPtr));
  36. static int        GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
  37.                 int objIndex, char *fileName,
  38.                 Tcl_Obj **attributePtrPtr));
  39. static int        SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  40.                 int objIndex, char *fileName,
  41.                 Tcl_Obj *attributePtr));
  42. static int        CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  43.                 int objIndex, char *fileName,
  44.                 Tcl_Obj *attributePtr));
  45.  
  46. /*
  47.  * Constants and variables necessary for file attributes subcommand.
  48.  */
  49.  
  50. enum {
  51.     WIN_ARCHIVE_ATTRIBUTE,
  52.     WIN_HIDDEN_ATTRIBUTE,
  53.     WIN_LONGNAME_ATTRIBUTE,
  54.     WIN_READONLY_ATTRIBUTE,
  55.     WIN_SHORTNAME_ATTRIBUTE,
  56.     WIN_SYSTEM_ATTRIBUTE
  57. };
  58.  
  59. static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
  60.     0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
  61.  
  62.  
  63. char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
  64.     "-shortname", "-system", (char *) NULL};
  65. CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  66.     {GetWinFileAttributes, SetWinFileAttributes},
  67.     {GetWinFileAttributes, SetWinFileAttributes},
  68.     {GetWinFileLongName, CannotSetAttribute},
  69.     {GetWinFileAttributes, SetWinFileAttributes},
  70.     {GetWinFileShortName, CannotSetAttribute},
  71.     {GetWinFileAttributes, SetWinFileAttributes}};
  72.  
  73. /*
  74.  * Prototype for the TraverseWinTree callback function.
  75.  */
  76.  
  77. typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type, 
  78.     Tcl_DString *errorPtr);
  79.  
  80. /*
  81.  * Declarations for local procedures defined in this file:
  82.  */
  83.  
  84. static void        AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
  85.                 int objIndex, char *fileName, int getOrSet));
  86. static int        ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
  87.                 int objIndex, char *fileName, int longShort,
  88.                 Tcl_Obj **attributePtrPtr));
  89. static int        TraversalCopy(char *src, char *dst, DWORD attr, 
  90.                 int type, Tcl_DString *errorPtr);
  91. static int        TraversalDelete(char *src, char *dst, DWORD attr,
  92.                 int type, Tcl_DString *errorPtr);
  93. static int        TraverseWinTree(TraversalProc *traverseProc,
  94.                 Tcl_DString *sourcePtr, Tcl_DString *destPtr,
  95.                 Tcl_DString *errorPtr);
  96.  
  97.  
  98. /*
  99.  *---------------------------------------------------------------------------
  100.  *
  101.  * TclpRenameFile --
  102.  *
  103.  *      Changes the name of an existing file or directory, from src to dst.
  104.  *    If src and dst refer to the same file or directory, does nothing
  105.  *    and returns success.  Otherwise if dst already exists, it will be
  106.  *    deleted and replaced by src subject to the following conditions:
  107.  *        If src is a directory, dst may be an empty directory.
  108.  *        If src is a file, dst may be a file.
  109.  *    In any other situation where dst already exists, the rename will
  110.  *    fail.  
  111.  *
  112.  * Results:
  113.  *    If the directory was successfully created, returns TCL_OK.
  114.  *    Otherwise the return value is TCL_ERROR and errno is set to
  115.  *    indicate the error.  Some possible values for errno are:
  116.  *
  117.  *    EACCES:     src or dst parent directory can't be read and/or written.
  118.  *    EEXIST:        dst is a non-empty directory.
  119.  *    EINVAL:        src is a root directory or dst is a subdirectory of src.
  120.  *    EISDIR:        dst is a directory, but src is not.
  121.  *    ENOENT:        src doesn't exist.  src or dst is "".
  122.  *    ENOTDIR:    src is a directory, but dst is not.  
  123.  *    EXDEV:        src and dst are on different filesystems.
  124.  *
  125.  *    EACCES:     exists an open file already referring to src or dst.
  126.  *    EACCES:     src or dst specify the current working directory (NT).
  127.  *    EACCES:        src specifies a char device (nul:, com1:, etc.) 
  128.  *    EEXIST:        dst specifies a char device (nul:, com1:, etc.) (NT)
  129.  *    EACCES:        dst specifies a char device (nul:, com1:, etc.) (95)
  130.  *    
  131.  * Side effects:
  132.  *    The implementation supports cross-filesystem renames of files,
  133.  *    but the caller should be prepared to emulate cross-filesystem
  134.  *    renames of directories if errno is EXDEV.
  135.  *
  136.  *---------------------------------------------------------------------------
  137.  */
  138.  
  139. int
  140. TclpRenameFile(
  141.     char *src,            /* Pathname of file or dir to be renamed. */ 
  142.     char *dst)            /* New pathname for file or directory. */
  143. {
  144.     DWORD srcAttr, dstAttr;
  145.     
  146.     /*
  147.      * Would throw an exception under NT if one of the arguments is a 
  148.      * char block device.
  149.      */
  150.  
  151.     try {
  152.     if (MoveFile(src, dst) != FALSE) {
  153.         return TCL_OK;
  154.     }
  155.     } except (-1) {}
  156.  
  157.     TclWinConvertError(GetLastError());
  158.  
  159.     srcAttr = GetFileAttributes(src);
  160.     dstAttr = GetFileAttributes(dst);
  161.     if (srcAttr == (DWORD) -1) {
  162.     srcAttr = 0;
  163.     }
  164.     if (dstAttr == (DWORD) -1) {
  165.     dstAttr = 0;
  166.     }
  167.  
  168.     if (errno == EBADF) {
  169.     errno = EACCES;
  170.     return TCL_ERROR;
  171.     }
  172.     if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
  173.     if ((srcAttr != 0) && (dstAttr != 0)) {
  174.         /*
  175.          * Win32s reports trying to overwrite an existing file or directory
  176.          * as EACCES.
  177.          */
  178.  
  179.         errno = EEXIST;
  180.     }
  181.     }
  182.     if (errno == EACCES) {
  183.     decode:
  184.     if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
  185.         char srcPath[MAX_PATH], dstPath[MAX_PATH];
  186.         int srcArgc, dstArgc;
  187.         char **srcArgv, **dstArgv;
  188.         char *srcRest, *dstRest;
  189.         int size;
  190.  
  191.         size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
  192.         if ((size == 0) || (size > sizeof(srcPath))) {
  193.         return TCL_ERROR;
  194.         }
  195.         size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
  196.         if ((size == 0) || (size > sizeof(dstPath))) {
  197.         return TCL_ERROR;
  198.         }
  199.         if (srcRest == NULL) {
  200.         srcRest = srcPath + strlen(srcPath);
  201.         }
  202.         if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
  203.         /*
  204.          * Trying to move a directory into itself.
  205.          */
  206.  
  207.         errno = EINVAL;
  208.         return TCL_ERROR;
  209.         }
  210.         Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
  211.         Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
  212.         if (srcArgc == 1) {
  213.         /*
  214.          * They are trying to move a root directory.  Whether
  215.          * or not it is across filesystems, this cannot be
  216.          * done.
  217.          */
  218.  
  219.         errno = EINVAL;
  220.         } else if ((srcArgc > 0) && (dstArgc > 0) &&
  221.             (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
  222.         /*
  223.          * If src is a directory and dst filesystem != src
  224.          * filesystem, errno should be EXDEV.  It is very
  225.          * important to get this behavior, so that the caller
  226.          * can respond to a cross filesystem rename by
  227.          * simulating it with copy and delete.  The MoveFile
  228.          * system call already handles the case of moving a
  229.          * file between filesystems.
  230.          */
  231.  
  232.         errno = EXDEV;
  233.         }
  234.  
  235.         ckfree((char *) srcArgv);
  236.         ckfree((char *) dstArgv);
  237.     }
  238.  
  239.     /*
  240.      * Other types of access failure is that dst is a read-only
  241.      * filesystem, that an open file referred to src or dest, or that
  242.      * src or dest specified the current working directory on the
  243.      * current filesystem.  EACCES is returned for those cases.
  244.      */
  245.  
  246.     } else if (errno == EEXIST) {
  247.     /*
  248.      * Reports EEXIST any time the target already exists.  If it makes
  249.      * sense, remove the old file and try renaming again.
  250.      */
  251.  
  252.     if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
  253.         if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
  254.         /*
  255.          * Overwrite empty dst directory with src directory.  The
  256.          * following call will remove an empty directory.  If it
  257.          * fails, it's because it wasn't empty.
  258.          */
  259.  
  260.         if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
  261.             /*
  262.              * Now that that empty directory is gone, we can try
  263.              * renaming again.  If that fails, we'll put this empty
  264.              * directory back, for completeness.
  265.              */
  266.  
  267.             if (MoveFile(src, dst) != FALSE) {
  268.             return TCL_OK;
  269.             }
  270.  
  271.             /*
  272.              * Some new error has occurred.  Don't know what it
  273.              * could be, but report this one.
  274.              */
  275.  
  276.             TclWinConvertError(GetLastError());
  277.             CreateDirectory(dst, NULL);
  278.             SetFileAttributes(dst, dstAttr);
  279.             if (errno == EACCES) {
  280.             /*
  281.              * Decode the EACCES to a more meaningful error.
  282.              */
  283.  
  284.             goto decode;
  285.             }
  286.         }
  287.         } else {    /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
  288.         errno = ENOTDIR;
  289.         }
  290.     } else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
  291.         if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
  292.         errno = EISDIR;
  293.         } else {
  294.         /*
  295.          * Overwrite existing file by:
  296.          * 
  297.          * 1. Rename existing file to temp name.
  298.          * 2. Rename old file to new name.
  299.          * 3. If success, delete temp file.  If failure,
  300.          *    put temp file back to old name.
  301.          */
  302.  
  303.         char tempName[MAX_PATH];
  304.         int result, size;
  305.         char *rest;
  306.         
  307.         size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
  308.         if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
  309.             return TCL_ERROR;
  310.         }
  311.         *rest = '\0';
  312.         result = TCL_ERROR;
  313.         if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
  314.             /*
  315.              * Strictly speaking, need the following DeleteFile and
  316.              * MoveFile to be joined as an atomic operation so no
  317.              * other app comes along in the meantime and creates the
  318.              * same temp file.
  319.              */
  320.              
  321.             DeleteFile(tempName);
  322.             if (MoveFile(dst, tempName) != FALSE) {
  323.             if (MoveFile(src, dst) != FALSE) {
  324.                 SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
  325.                 DeleteFile(tempName);
  326.                 return TCL_OK;
  327.             } else {
  328.                 DeleteFile(dst);
  329.                 MoveFile(tempName, dst);
  330.             }
  331.             } 
  332.  
  333.             /*
  334.              * Can't backup dst file or move src file.  Return that
  335.              * error.  Could happen if an open file refers to dst.
  336.              */
  337.  
  338.             TclWinConvertError(GetLastError());
  339.             if (errno == EACCES) {
  340.             /*
  341.              * Decode the EACCES to a more meaningful error.
  342.              */
  343.  
  344.             goto decode;
  345.             }
  346.         }
  347.         return result;
  348.         }
  349.     }
  350.     }
  351.     return TCL_ERROR;
  352. }
  353.  
  354. /*
  355.  *---------------------------------------------------------------------------
  356.  *
  357.  * TclpCopyFile --
  358.  *
  359.  *      Copy a single file (not a directory).  If dst already exists and
  360.  *    is not a directory, it is removed.
  361.  *
  362.  * Results:
  363.  *    If the file was successfully copied, returns TCL_OK.  Otherwise
  364.  *    the return value is TCL_ERROR and errno is set to indicate the
  365.  *    error.  Some possible values for errno are:
  366.  *
  367.  *    EACCES:     src or dst parent directory can't be read and/or written.
  368.  *    EISDIR:        src or dst is a directory.
  369.  *    ENOENT:        src doesn't exist.  src or dst is "".
  370.  *
  371.  *    EACCES:     exists an open file already referring to dst (95).
  372.  *    EACCES:        src specifies a char device (nul:, com1:, etc.) (NT)
  373.  *    ENOENT:        src specifies a char device (nul:, com1:, etc.) (95)
  374.  *
  375.  * Side effects:
  376.  *    It is not an error to copy to a char device.
  377.  *
  378.  *---------------------------------------------------------------------------
  379.  */
  380.  
  381. int 
  382. TclpCopyFile(
  383.     char *src,            /* Pathname of file to be copied. */
  384.     char *dst)            /* Pathname of file to copy to. */
  385. {
  386.     /*
  387.      * Would throw an exception under NT if one of the arguments is a char
  388.      * block device.
  389.      */
  390.  
  391.     try {
  392.     if (CopyFile(src, dst, 0) != FALSE) {
  393.         return TCL_OK;
  394.     }
  395.     } except (-1) {}
  396.  
  397.     TclWinConvertError(GetLastError());
  398.     if (errno == EBADF) {
  399.     errno = EACCES;
  400.     return TCL_ERROR;
  401.     }
  402.     if (errno == EACCES) {
  403.     DWORD srcAttr, dstAttr;
  404.  
  405.     srcAttr = GetFileAttributes(src);
  406.     dstAttr = GetFileAttributes(dst);
  407.     if (srcAttr != (DWORD) -1) {
  408.         if (dstAttr == (DWORD) -1) {
  409.         dstAttr = 0;
  410.         }
  411.         if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
  412.             (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
  413.         errno = EISDIR;
  414.         }
  415.         if (dstAttr & FILE_ATTRIBUTE_READONLY) {
  416.         SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
  417.         if (CopyFile(src, dst, 0) != FALSE) {
  418.             return TCL_OK;
  419.         }
  420.         /*
  421.          * Still can't copy onto dst.  Return that error, and
  422.          * restore attributes of dst.
  423.          */
  424.  
  425.         TclWinConvertError(GetLastError());
  426.         SetFileAttributes(dst, dstAttr);
  427.         }
  428.     }
  429.     }
  430.     return TCL_ERROR;
  431. }
  432.  
  433. /*
  434.  *---------------------------------------------------------------------------
  435.  *
  436.  * TclpDeleteFile --
  437.  *
  438.  *      Removes a single file (not a directory).
  439.  *
  440.  * Results:
  441.  *    If the file was successfully deleted, returns TCL_OK.  Otherwise
  442.  *    the return value is TCL_ERROR and errno is set to indicate the
  443.  *    error.  Some possible values for errno are:
  444.  *
  445.  *    EACCES:     a parent directory can't be read and/or written.
  446.  *    EISDIR:        path is a directory.
  447.  *    ENOENT:        path doesn't exist or is "".
  448.  *
  449.  *    EACCES:     exists an open file already referring to path.
  450.  *    EACCES:        path is a char device (nul:, com1:, etc.)
  451.  *
  452.  * Side effects:
  453.  *      The file is deleted, even if it is read-only.
  454.  *
  455.  *---------------------------------------------------------------------------
  456.  */
  457.  
  458. int
  459. TclpDeleteFile(
  460.     char *path)            /* Pathname of file to be removed. */
  461. {
  462.     DWORD attr;
  463.  
  464.     if (DeleteFile(path) != FALSE) {
  465.     return TCL_OK;
  466.     }
  467.     TclWinConvertError(GetLastError());
  468.     if (path[0] == '\0') {
  469.     /*
  470.      * Win32s thinks that "" is the same as "." and then reports EISDIR
  471.      * instead of ENOENT.
  472.      */
  473.  
  474.     errno = ENOENT;
  475.     } else if (errno == EACCES) {
  476.         attr = GetFileAttributes(path);
  477.     if (attr != (DWORD) -1) {
  478.         if (attr & FILE_ATTRIBUTE_DIRECTORY) {
  479.         /*
  480.          * Windows NT reports removing a directory as EACCES instead
  481.          * of EISDIR.
  482.          */
  483.  
  484.         errno = EISDIR;
  485.         } else if (attr & FILE_ATTRIBUTE_READONLY) {
  486.         SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
  487.         if (DeleteFile(path) != FALSE) {
  488.             return TCL_OK;
  489.         }
  490.         TclWinConvertError(GetLastError());
  491.         SetFileAttributes(path, attr);
  492.         }
  493.     }
  494.     } else if (errno == ENOENT) {
  495.         attr = GetFileAttributes(path);
  496.     if (attr != (DWORD) -1) {
  497.         if (attr & FILE_ATTRIBUTE_DIRECTORY) {
  498.             /*
  499.          * Windows 95 reports removing a directory as ENOENT instead 
  500.          * of EISDIR. 
  501.          */
  502.  
  503.         errno = EISDIR;
  504.         }
  505.     }
  506.     } else if (errno == EINVAL) {
  507.     /*
  508.      * Windows NT reports removing a char device as EINVAL instead of
  509.      * EACCES.
  510.      */
  511.  
  512.     errno = EACCES;
  513.     }
  514.  
  515.     return TCL_ERROR;
  516. }
  517.  
  518. /*
  519.  *---------------------------------------------------------------------------
  520.  *
  521.  * TclpCreateDirectory --
  522.  *
  523.  *      Creates the specified directory.  All parent directories of the
  524.  *    specified directory must already exist.  The directory is
  525.  *    automatically created with permissions so that user can access
  526.  *    the new directory and create new files or subdirectories in it.
  527.  *
  528.  * Results:
  529.  *    If the directory was successfully created, returns TCL_OK.
  530.  *    Otherwise the return value is TCL_ERROR and errno is set to
  531.  *    indicate the error.  Some possible values for errno are:
  532.  *
  533.  *    EACCES:     a parent directory can't be read and/or written.
  534.  *    EEXIST:        path already exists.
  535.  *    ENOENT:        a parent directory doesn't exist.
  536.  *
  537.  * Side effects:
  538.  *      A directory is created.
  539.  *
  540.  *---------------------------------------------------------------------------
  541.  */
  542.  
  543. int
  544. TclpCreateDirectory(
  545.     char *path)            /* Pathname of directory to create */
  546. {
  547.     int error;
  548.  
  549.     if (CreateDirectory(path, NULL) == 0) {
  550.     error = GetLastError();
  551.     if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
  552.         if ((error == ERROR_ACCESS_DENIED) 
  553.             && (GetFileAttributes(path) != (DWORD) -1)) {
  554.         error = ERROR_FILE_EXISTS;
  555.         }
  556.     }
  557.     TclWinConvertError(error);
  558.     return TCL_ERROR;
  559.     }   
  560.     return TCL_OK;
  561. }
  562.  
  563. /*
  564.  *---------------------------------------------------------------------------
  565.  *
  566.  * TclpCopyDirectory --
  567.  *
  568.  *      Recursively copies a directory.  The target directory dst must
  569.  *    not already exist.  Note that this function does not merge two
  570.  *    directory hierarchies, even if the target directory is an an
  571.  *    empty directory.
  572.  *
  573.  * Results:
  574.  *    If the directory was successfully copied, returns TCL_OK.
  575.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  576.  *    the error, and the pathname of the file that caused the error
  577.  *    is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
  578.  *    for a description of possible values for errno.
  579.  *
  580.  * Side effects:
  581.  *      An exact copy of the directory hierarchy src will be created
  582.  *    with the name dst.  If an error occurs, the error will
  583.  *      be returned immediately, and remaining files will not be
  584.  *    processed.
  585.  *
  586.  *---------------------------------------------------------------------------
  587.  */
  588.  
  589. int
  590. TclpCopyDirectory(
  591.     char *src,            /* Pathname of directory to be copied. */
  592.     char *dst,            /* Pathname of target directory. */
  593.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  594.                  * error reporting. */
  595. {
  596.     int result;
  597.     Tcl_DString srcBuffer;
  598.     Tcl_DString dstBuffer;
  599.  
  600.     Tcl_DStringInit(&srcBuffer);
  601.     Tcl_DStringInit(&dstBuffer);
  602.     Tcl_DStringAppend(&srcBuffer, src, -1);
  603.     Tcl_DStringAppend(&dstBuffer, dst, -1);
  604.     result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer, 
  605.         errorPtr);
  606.     Tcl_DStringFree(&srcBuffer);
  607.     Tcl_DStringFree(&dstBuffer);
  608.     return result;
  609. }
  610.  
  611. /*
  612.  *----------------------------------------------------------------------
  613.  *
  614.  * TclpRemoveDirectory -- 
  615.  *
  616.  *    Removes directory (and its contents, if the recursive flag is set).
  617.  *
  618.  * Results:
  619.  *    If the directory was successfully removed, returns TCL_OK.
  620.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  621.  *    the error, and the pathname of the file that caused the error
  622.  *    is stored in errorPtr.  Some possible values for errno are:
  623.  *
  624.  *    EACCES:     path directory can't be read and/or written.
  625.  *    EEXIST:        path is a non-empty directory.
  626.  *    EINVAL:        path is root directory or current directory.
  627.  *    ENOENT:        path doesn't exist or is "".
  628.  *     ENOTDIR:    path is not a directory.
  629.  *
  630.  *    EACCES:        path is a char device (nul:, com1:, etc.) (95)
  631.  *    EINVAL:        path is a char device (nul:, com1:, etc.) (NT)
  632.  *
  633.  * Side effects:
  634.  *    Directory removed.  If an error occurs, the error will be returned
  635.  *    immediately, and remaining files will not be deleted.
  636.  *
  637.  *----------------------------------------------------------------------
  638.  */
  639.  
  640. int
  641. TclpRemoveDirectory(
  642.     char *path,            /* Pathname of directory to be removed. */
  643.     int recursive,        /* If non-zero, removes directories that
  644.                  * are nonempty.  Otherwise, will only remove
  645.                  * empty directories. */
  646.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  647.                  * error reporting. */
  648. {
  649.     int result;
  650.     Tcl_DString buffer;
  651.     DWORD attr;
  652.  
  653.     if (RemoveDirectory(path) != FALSE) {
  654.     return TCL_OK;
  655.     }
  656.     TclWinConvertError(GetLastError());
  657.     if (path[0] == '\0') {
  658.     /*
  659.      * Win32s thinks that "" is the same as "." and then reports EACCES
  660.      * instead of ENOENT.
  661.      */
  662.  
  663.     errno = ENOENT;
  664.     }
  665.     if (errno == EACCES) {
  666.     attr = GetFileAttributes(path);
  667.     if (attr != (DWORD) -1) {
  668.         if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
  669.         /* 
  670.          * Windows 95 reports calling RemoveDirectory on a file as an 
  671.          * EACCES, not an ENOTDIR.
  672.          */
  673.         
  674.         errno = ENOTDIR;
  675.         goto end;
  676.         }
  677.  
  678.         if (attr & FILE_ATTRIBUTE_READONLY) {
  679.         attr &= ~FILE_ATTRIBUTE_READONLY;
  680.         if (SetFileAttributes(path, attr) == FALSE) {
  681.             goto end;
  682.         }
  683.         if (RemoveDirectory(path) != FALSE) {
  684.             return TCL_OK;
  685.         }
  686.         TclWinConvertError(GetLastError());
  687.         SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
  688.         }
  689.  
  690.         /* 
  691.          * Windows 95 and Win32s report removing a non-empty directory 
  692.          * as EACCES, not EEXIST.  If the directory is not empty,
  693.          * change errno so caller knows what's going on.
  694.          */
  695.  
  696.         if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
  697.         HANDLE handle;
  698.         WIN32_FIND_DATA data;
  699.         Tcl_DString buffer;
  700.         char *find;
  701.         int len;
  702.  
  703.         Tcl_DStringInit(&buffer);
  704.         find = Tcl_DStringAppend(&buffer, path, -1);
  705.         len = Tcl_DStringLength(&buffer);
  706.         if ((len > 0) && (find[len - 1] != '\\')) {
  707.             Tcl_DStringAppend(&buffer, "\\", 1);
  708.         }
  709.         find = Tcl_DStringAppend(&buffer, "*.*", 3);
  710.         handle = FindFirstFile(find, &data);
  711.         if (handle != INVALID_HANDLE_VALUE) {
  712.             while (1) {
  713.             if ((strcmp(data.cFileName, ".") != 0)
  714.                 && (strcmp(data.cFileName, "..") != 0)) {
  715.                 /*
  716.                  * Found something in this directory.
  717.                  */
  718.  
  719.                 errno = EEXIST;
  720.                 break;
  721.             }
  722.             if (FindNextFile(handle, &data) == FALSE) {
  723.                 break;
  724.             }
  725.             }
  726.             FindClose(handle);
  727.         }
  728.         Tcl_DStringFree(&buffer);
  729.         }
  730.     }
  731.     }
  732.     if (errno == ENOTEMPTY) {
  733.     /* 
  734.      * The caller depends on EEXIST to signify that the directory is
  735.      * not empty, not ENOTEMPTY. 
  736.      */
  737.  
  738.     errno = EEXIST;
  739.     }
  740.     if ((recursive != 0) && (errno == EEXIST)) {
  741.     /*
  742.      * The directory is nonempty, but the recursive flag has been
  743.      * specified, so we recursively remove all the files in the directory.
  744.      */
  745.  
  746.     Tcl_DStringInit(&buffer);
  747.     Tcl_DStringAppend(&buffer, path, -1);
  748.     result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
  749.     Tcl_DStringFree(&buffer);
  750.     return result;
  751.     }
  752.  
  753.     end:
  754.     if (errorPtr != NULL) {
  755.         Tcl_DStringAppend(errorPtr, path, -1);
  756.     }
  757.     return TCL_ERROR;
  758. }
  759.  
  760. /*
  761.  *---------------------------------------------------------------------------
  762.  *
  763.  * TraverseWinTree --
  764.  *
  765.  *      Traverse directory tree specified by sourcePtr, calling the function 
  766.  *    traverseProc for each file and directory encountered.  If destPtr 
  767.  *    is non-null, each of name in the sourcePtr directory is appended to 
  768.  *    the directory specified by destPtr and passed as the second argument 
  769.  *    to traverseProc() .
  770.  *
  771.  * Results:
  772.  *      Standard Tcl result.
  773.  *
  774.  * Side effects:
  775.  *      None caused by TraverseWinTree, however the user specified 
  776.  *    traverseProc() may change state.  If an error occurs, the error will
  777.  *      be returned immediately, and remaining files will not be processed.
  778.  *
  779.  *---------------------------------------------------------------------------
  780.  */
  781.  
  782. static int 
  783. TraverseWinTree(
  784.     TraversalProc *traverseProc,/* Function to call for every file and
  785.                  * directory in source hierarchy. */
  786.     Tcl_DString *sourcePtr,    /* Pathname of source directory to be
  787.                  * traversed. */
  788.     Tcl_DString *targetPtr,    /* Pathname of directory to traverse in
  789.                  * parallel with source directory. */
  790.     Tcl_DString *errorPtr)    /* If non-NULL, an initialized DString for
  791.                  * error reporting. */
  792. {
  793.     DWORD sourceAttr;
  794.     char *source, *target, *errfile;
  795.     int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
  796.     HANDLE handle;
  797.     WIN32_FIND_DATA data;
  798.  
  799.     result = TCL_OK;
  800.     source = Tcl_DStringValue(sourcePtr);
  801.     sourceLenOriginal = Tcl_DStringLength(sourcePtr);
  802.     if (targetPtr != NULL) {
  803.     target = Tcl_DStringValue(targetPtr);
  804.     targetLenOriginal = Tcl_DStringLength(targetPtr);
  805.     } else {
  806.     target = NULL;
  807.     targetLenOriginal = 0;
  808.     }
  809.  
  810.     errfile = NULL;
  811.  
  812.     sourceAttr = GetFileAttributes(source);
  813.     if (sourceAttr == (DWORD) -1) {
  814.     errfile = source;
  815.     goto end;
  816.     }
  817.     if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
  818.     /*
  819.      * Process the regular file
  820.      */
  821.  
  822.     return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
  823.     }
  824.  
  825.     /*
  826.      * When given the pathname of the form "c:\" (one that already ends
  827.      * with a backslash), must make sure not to add another "\" to the end
  828.      * otherwise it will try to access a network drive.  
  829.      */
  830.  
  831.     sourceLen = sourceLenOriginal;
  832.     if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
  833.     Tcl_DStringAppend(sourcePtr, "\\", 1);
  834.     sourceLen++;
  835.     }
  836.     source = Tcl_DStringAppend(sourcePtr, "*.*", 3); 
  837.     handle = FindFirstFile(source, &data);
  838.     Tcl_DStringSetLength(sourcePtr, sourceLen);
  839.     if (handle == INVALID_HANDLE_VALUE) {
  840.     /* 
  841.      * Can't read directory
  842.      */
  843.  
  844.     TclWinConvertError(GetLastError());
  845.     errfile = source;
  846.     goto end;
  847.     }
  848.  
  849.     result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
  850.     if (result != TCL_OK) {
  851.     FindClose(handle);
  852.     return result;
  853.     }
  854.  
  855.     if (targetPtr != NULL) {
  856.     targetLen = targetLenOriginal;
  857.     if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
  858.         target = Tcl_DStringAppend(targetPtr, "\\", 1);
  859.         targetLen++;
  860.     }
  861.     }
  862.  
  863.     while (1) {
  864.     if ((strcmp(data.cFileName, ".") != 0)
  865.             && (strcmp(data.cFileName, "..") != 0)) {
  866.         /* 
  867.          * Append name after slash, and recurse on the file. 
  868.          */
  869.  
  870.         Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
  871.         if (targetPtr != NULL) {
  872.         Tcl_DStringAppend(targetPtr, data.cFileName, -1);
  873.         }
  874.         result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 
  875.             errorPtr);
  876.         if (result != TCL_OK) {
  877.         break;
  878.         }
  879.  
  880.         /*
  881.          * Remove name after slash.
  882.          */
  883.  
  884.         Tcl_DStringSetLength(sourcePtr, sourceLen);
  885.         if (targetPtr != NULL) {
  886.         Tcl_DStringSetLength(targetPtr, targetLen);
  887.         }
  888.     }
  889.     if (FindNextFile(handle, &data) == FALSE) {
  890.         break;
  891.     }
  892.     }
  893.     FindClose(handle);
  894.  
  895.     /*
  896.      * Strip off the trailing slash we added
  897.      */
  898.  
  899.     Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
  900.     source = Tcl_DStringValue(sourcePtr);
  901.     if (targetPtr != NULL) {
  902.     Tcl_DStringSetLength(targetPtr, targetLenOriginal);
  903.     target = Tcl_DStringValue(targetPtr);
  904.     }
  905.  
  906.     if (result == TCL_OK) {
  907.     /*
  908.      * Call traverseProc() on a directory after visiting all the
  909.      * files in that directory.
  910.      */
  911.  
  912.     result = (*traverseProc)(source, target, sourceAttr, 
  913.         DOTREE_POSTD, errorPtr);
  914.     }
  915.     end:
  916.     if (errfile != NULL) {
  917.     TclWinConvertError(GetLastError());
  918.     if (errorPtr != NULL) {
  919.         Tcl_DStringAppend(errorPtr, errfile, -1);
  920.     }
  921.     result = TCL_ERROR;
  922.     }
  923.         
  924.     return result;
  925. }
  926.  
  927. /*
  928.  *----------------------------------------------------------------------
  929.  *
  930.  * TraversalCopy
  931.  *
  932.  *      Called from TraverseUnixTree in order to execute a recursive
  933.  *      copy of a directory.
  934.  *
  935.  * Results:
  936.  *      Standard Tcl result.
  937.  *
  938.  * Side effects:
  939.  *      Depending on the value of type, src may be copied to dst.
  940.  *      
  941.  *----------------------------------------------------------------------
  942.  */
  943.  
  944. static int 
  945. TraversalCopy(
  946.     char *src,            /* Source pathname to copy. */
  947.     char *dst,            /* Destination pathname of copy. */
  948.     DWORD srcAttr,        /* File attributes for src. */
  949.     int type,            /* Reason for call - see TraverseWinTree() */
  950.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  951.                  * error return. */
  952. {
  953.     switch (type) {
  954.     case DOTREE_F:
  955.         if (TclpCopyFile(src, dst) == TCL_OK) {
  956.         return TCL_OK;
  957.         }
  958.         break;
  959.  
  960.     case DOTREE_PRED:
  961.         if (TclpCreateDirectory(dst) == TCL_OK) {
  962.         if (SetFileAttributes(dst, srcAttr) != FALSE) {
  963.             return TCL_OK;
  964.         }
  965.         TclWinConvertError(GetLastError());
  966.         }
  967.         break;
  968.  
  969.         case DOTREE_POSTD:
  970.         return TCL_OK;
  971.  
  972.     }
  973.  
  974.     /*
  975.      * There shouldn't be a problem with src, because we already
  976.      * checked it to get here.
  977.      */
  978.  
  979.     if (errorPtr != NULL) {
  980.     Tcl_DStringAppend(errorPtr, dst, -1);
  981.     }
  982.     return TCL_ERROR;
  983. }
  984.  
  985. /*
  986.  *----------------------------------------------------------------------
  987.  *
  988.  * TraversalDelete --
  989.  *
  990.  *      Called by procedure TraverseWinTree for every file and
  991.  *      directory that it encounters in a directory hierarchy. This
  992.  *      procedure unlinks files, and removes directories after all the
  993.  *      containing files have been processed.
  994.  *
  995.  * Results:
  996.  *      Standard Tcl result.
  997.  *
  998.  * Side effects:
  999.  *      Files or directory specified by src will be deleted. If an
  1000.  *      error occurs, the windows error is converted to a Posix error
  1001.  *      and errno is set accordingly.
  1002.  *
  1003.  *----------------------------------------------------------------------
  1004.  */
  1005.  
  1006. static int
  1007. TraversalDelete( 
  1008.     char *src,            /* Source pathname. */
  1009.     char *ignore,        /* Destination pathname (not used). */
  1010.     DWORD srcAttr,        /* File attributes for src (not used). */
  1011.     int type,            /* Reason for call - see TraverseWinTree(). */
  1012.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  1013.                  * error return. */
  1014. {
  1015.     switch (type) {
  1016.     case DOTREE_F:
  1017.         if (TclpDeleteFile(src) == TCL_OK) {
  1018.         return TCL_OK;
  1019.         }
  1020.         break;
  1021.  
  1022.     case DOTREE_PRED:
  1023.         return TCL_OK;
  1024.  
  1025.     case DOTREE_POSTD:
  1026.         if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
  1027.         return TCL_OK;
  1028.         }
  1029.         break;
  1030.  
  1031.     }
  1032.  
  1033.     if (errorPtr != NULL) {
  1034.     Tcl_DStringAppend(errorPtr, src, -1);
  1035.     }
  1036.     return TCL_ERROR;
  1037. }
  1038.  
  1039. /*
  1040.  *----------------------------------------------------------------------
  1041.  *
  1042.  * AttributesPosixError --
  1043.  *
  1044.  *    Sets the object result with the appropriate error.
  1045.  *
  1046.  * Results:
  1047.  *      None.
  1048.  *
  1049.  * Side effects:
  1050.  *      The interp's object result is set with an error message
  1051.  *    based on the objIndex, fileName and errno.
  1052.  *
  1053.  *----------------------------------------------------------------------
  1054.  */
  1055.  
  1056. static void
  1057. AttributesPosixError(
  1058.     Tcl_Interp *interp,        /* The interp that has the error */
  1059.     int objIndex,        /* The attribute which caused the problem. */
  1060.     char *fileName,        /* The name of the file which caused the 
  1061.                  * error. */
  1062.     int getOrSet)        /* 0 for get; 1 for set */
  1063. {
  1064.     TclWinConvertError(GetLastError());
  1065.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1066.         "cannot ", getOrSet ? "set" : "get", " attribute \"", 
  1067.         tclpFileAttrStrings[objIndex], "\" for file \"", fileName, 
  1068.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  1069. }
  1070.  
  1071. /*
  1072.  *----------------------------------------------------------------------
  1073.  *
  1074.  * GetWinFileAttributes --
  1075.  *
  1076.  *      Returns a Tcl_Obj containing the value of a file attribute.
  1077.  *    This routine gets the -hidden, -readonly or -system attribute.
  1078.  *
  1079.  * Results:
  1080.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1081.  *    will have ref count 0. If the return value is not TCL_OK,
  1082.  *    attributePtrPtr is not touched.
  1083.  *
  1084.  * Side effects:
  1085.  *      A new object is allocated if the file is valid.
  1086.  *
  1087.  *----------------------------------------------------------------------
  1088.  */
  1089.  
  1090. static int
  1091. GetWinFileAttributes(
  1092.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1093.     int objIndex,            /* The index of the attribute. */
  1094.     char *fileName,            /* The name of the file. */
  1095.     Tcl_Obj **attributePtrPtr)        /* A pointer to return the object with. */
  1096. {
  1097.     DWORD result = GetFileAttributes(fileName);
  1098.  
  1099.     if (result == 0xFFFFFFFF) {
  1100.     AttributesPosixError(interp, objIndex, fileName, 0);
  1101.     return TCL_ERROR;
  1102.     }
  1103.  
  1104.     *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
  1105.     return TCL_OK;
  1106. }
  1107.  
  1108. /*
  1109.  *----------------------------------------------------------------------
  1110.  *
  1111.  * ConvertFileNameFormat --
  1112.  *
  1113.  *      Returns a Tcl_Obj containing either the long or short version of the 
  1114.  *    file name.
  1115.  *
  1116.  * Results:
  1117.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1118.  *    will have ref count 0. If the return value is not TCL_OK,
  1119.  *    attributePtrPtr is not touched.
  1120.  *
  1121.  * Side effects:
  1122.  *      A new object is allocated if the file is valid.
  1123.  *
  1124.  *----------------------------------------------------------------------
  1125.  */
  1126.  
  1127. static int
  1128. ConvertFileNameFormat(
  1129.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1130.     int objIndex,            /* The index of the attribute. */
  1131.     char *fileName,            /* The name of the file. */
  1132.     int longShort,            /* 0 to short name, 1 to long name. */
  1133.     Tcl_Obj **attributePtrPtr)        /* A pointer to return the object with. */
  1134. {
  1135.     HANDLE findHandle;
  1136.     WIN32_FIND_DATA findData;
  1137.     int pathArgc, i;
  1138.     char **pathArgv, **newPathArgv;
  1139.     char *currentElement, *resultStr;
  1140.     Tcl_DString resultDString;
  1141.     int result = TCL_OK;
  1142.  
  1143.     Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
  1144.     newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
  1145.  
  1146.     for (i = 0; i < pathArgc; i++) {
  1147.     if (strcmp(pathArgv[i], ".") == 0) {
  1148.         currentElement = ckalloc(strlen(".") + 1);
  1149.         strcpy(currentElement, ".");
  1150.     } else if (strcmp(pathArgv[i], "..") == 0) {
  1151.         currentElement = ckalloc(strlen("..") + 1);
  1152.         strcpy(currentElement, "..");
  1153.     } else if ((i == 0) && (pathArgv[i][1] == ':') 
  1154.         && (strlen(pathArgv[i]) == 3)) {
  1155.         currentElement = ckalloc(4);
  1156.         strcpy(currentElement, pathArgv[i]);
  1157.     } else if ((i == 0) && (pathArgv[i][0] == '/')
  1158.         && (pathArgv[i][1] == '/')) {
  1159.         currentElement = ckalloc(strlen(pathArgv[i]) + 1);
  1160.         strcpy(currentElement, pathArgv[i]);
  1161.     } else {
  1162.         int useLong;
  1163.  
  1164.         Tcl_DStringInit(&resultDString);
  1165.         resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
  1166.         findHandle = FindFirstFile(resultStr, &findData);
  1167.         if (findHandle == INVALID_HANDLE_VALUE) {
  1168.         pathArgc = i - 1;
  1169.         AttributesPosixError(interp, objIndex, fileName, 0);
  1170.         result = TCL_ERROR;
  1171.         Tcl_DStringFree(&resultDString);
  1172.         goto cleanup;
  1173.         }
  1174.         if (longShort) {
  1175.         if (findData.cFileName[0] != '\0') {
  1176.             useLong = 1;
  1177.         } else {
  1178.             useLong = 0;
  1179.         }
  1180.         } else {
  1181.         if (findData.cAlternateFileName[0] == '\0') {
  1182.             useLong = 1;
  1183.         } else {
  1184.             useLong = 0;
  1185.         }
  1186.         }
  1187.         if (useLong) {
  1188.         currentElement = ckalloc(strlen(findData.cFileName) + 1);
  1189.         strcpy(currentElement, findData.cFileName);
  1190.         } else {
  1191.         currentElement = ckalloc(strlen(findData.cAlternateFileName) 
  1192.             + 1);
  1193.         strcpy(currentElement, findData.cAlternateFileName);
  1194.         }
  1195.         Tcl_DStringFree(&resultDString);
  1196.         FindClose(findHandle);
  1197.     }
  1198.     newPathArgv[i] = currentElement;
  1199.     }
  1200.  
  1201.     Tcl_DStringInit(&resultDString);
  1202.     resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
  1203.     *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
  1204.     Tcl_DStringFree(&resultDString);
  1205.  
  1206. cleanup:
  1207.     for (i = 0; i < pathArgc; i++) {
  1208.     ckfree(newPathArgv[i]);
  1209.     }
  1210.     ckfree((char *) newPathArgv);
  1211.     return result;
  1212. }
  1213.  
  1214. /*
  1215.  *----------------------------------------------------------------------
  1216.  *
  1217.  * GetWinFileLongName --
  1218.  *
  1219.  *      Returns a Tcl_Obj containing the short version of the file
  1220.  *    name.
  1221.  *
  1222.  * Results:
  1223.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1224.  *    will have ref count 0. If the return value is not TCL_OK,
  1225.  *    attributePtrPtr is not touched.
  1226.  *
  1227.  * Side effects:
  1228.  *      A new object is allocated if the file is valid.
  1229.  *
  1230.  *----------------------------------------------------------------------
  1231.  */
  1232.  
  1233. static int
  1234. GetWinFileLongName(
  1235.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1236.     int objIndex,            /* The index of the attribute. */
  1237.     char *fileName,            /* The name of the file. */
  1238.     Tcl_Obj **attributePtrPtr)        /* A pointer to return the object with. */
  1239. {
  1240.     return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
  1241. }
  1242.  
  1243. /*
  1244.  *----------------------------------------------------------------------
  1245.  *
  1246.  * GetWinFileShortName --
  1247.  *
  1248.  *      Returns a Tcl_Obj containing the short version of the file
  1249.  *    name.
  1250.  *
  1251.  * Results:
  1252.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1253.  *    will have ref count 0. If the return value is not TCL_OK,
  1254.  *    attributePtrPtr is not touched.
  1255.  *
  1256.  * Side effects:
  1257.  *      A new object is allocated if the file is valid.
  1258.  *
  1259.  *----------------------------------------------------------------------
  1260.  */
  1261.  
  1262. static int
  1263. GetWinFileShortName(
  1264.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1265.     int objIndex,            /* The index of the attribute. */
  1266.     char *fileName,            /* The name of the file. */
  1267.     Tcl_Obj **attributePtrPtr)        /* A pointer to return the object with. */
  1268. {
  1269.     return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
  1270. }
  1271.  
  1272. /*
  1273.  *----------------------------------------------------------------------
  1274.  *
  1275.  * SetWinFileAttributes --
  1276.  *
  1277.  *    Set the file attributes to the value given by attributePtr.
  1278.  *    This routine sets the -hidden, -readonly, or -system attributes.
  1279.  *
  1280.  * Results:
  1281.  *      Standard TCL error.
  1282.  *
  1283.  * Side effects:
  1284.  *      The file's attribute is set.
  1285.  *
  1286.  *----------------------------------------------------------------------
  1287.  */
  1288.  
  1289. static int
  1290. SetWinFileAttributes(
  1291.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1292.     int objIndex,            /* The index of the attribute. */
  1293.     char *fileName,            /* The name of the file. */
  1294.     Tcl_Obj *attributePtr)        /* The new value of the attribute. */
  1295. {
  1296.     DWORD fileAttributes = GetFileAttributes(fileName);
  1297.     int yesNo;
  1298.     int result;
  1299.  
  1300.     if (fileAttributes == 0xFFFFFFFF) {
  1301.     AttributesPosixError(interp, objIndex, fileName, 1);
  1302.     return TCL_ERROR;
  1303.     }
  1304.  
  1305.     result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
  1306.     if (result != TCL_OK) {
  1307.     return result;
  1308.     }
  1309.  
  1310.     if (yesNo) {
  1311.     fileAttributes |= (attributeArray[objIndex]);
  1312.     } else {
  1313.     fileAttributes &= ~(attributeArray[objIndex]);
  1314.     }
  1315.  
  1316.     if (!SetFileAttributes(fileName, fileAttributes)) {
  1317.     AttributesPosixError(interp, objIndex, fileName, 1);
  1318.     return TCL_ERROR;
  1319.     }
  1320.     return TCL_OK;
  1321. }
  1322.  
  1323. /*
  1324.  *----------------------------------------------------------------------
  1325.  *
  1326.  * SetWinFileLongName --
  1327.  *
  1328.  *    The attribute in question is a readonly attribute and cannot
  1329.  *    be set.
  1330.  *
  1331.  * Results:
  1332.  *      TCL_ERROR
  1333.  *
  1334.  * Side effects:
  1335.  *      The object result is set to a pertinant error message.
  1336.  *
  1337.  *----------------------------------------------------------------------
  1338.  */
  1339.  
  1340. static int
  1341. CannotSetAttribute(
  1342.     Tcl_Interp *interp,            /* The interp we are using for errors. */
  1343.     int objIndex,            /* The index of the attribute. */
  1344.     char *fileName,            /* The name of the file. */
  1345.     Tcl_Obj *attributePtr)        /* The new value of the attribute. */
  1346. {
  1347.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
  1348.         "cannot set attribute \"", tclpFileAttrStrings[objIndex],
  1349.         "\" for file \"", fileName, "\" : attribute is readonly", 
  1350.         (char *) NULL);
  1351.     return TCL_ERROR;
  1352. }
  1353.  
  1354.  
  1355. /*
  1356.  *---------------------------------------------------------------------------
  1357.  *
  1358.  * TclpListVolumes --
  1359.  *
  1360.  *    Lists the currently mounted volumes
  1361.  *
  1362.  * Results:
  1363.  *    A standard Tcl result.  Will always be TCL_OK, since there is no way
  1364.  *    that this command can fail.  Also, the interpreter's result is set to 
  1365.  *    the list of volumes.
  1366.  *
  1367.  * Side effects:
  1368.  *    None
  1369.  *
  1370.  *---------------------------------------------------------------------------
  1371.  */
  1372.  
  1373. int
  1374. TclpListVolumes( 
  1375.     Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
  1376. {
  1377.     Tcl_Obj *resultPtr, *elemPtr;
  1378.     char buf[4];
  1379.     int i;
  1380.  
  1381.     resultPtr = Tcl_GetObjResult(interp);
  1382.  
  1383.     buf[1] = ':';
  1384.     buf[2] = '/';
  1385.     buf[3] = '\0';
  1386.  
  1387.     /*
  1388.      * On Win32s: 
  1389.      * GetLogicalDriveStrings() isn't implemented.
  1390.      * GetLogicalDrives() returns incorrect information.
  1391.      */
  1392.  
  1393.     for (i = 0; i < 26; i++) {
  1394.         buf[0] = (char) ('a' + i);
  1395.     if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
  1396.         || (GetLastError() == ERROR_NOT_READY)) {
  1397.         elemPtr = Tcl_NewStringObj(buf, -1);
  1398.         Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
  1399.     }
  1400.     }
  1401.     return TCL_OK;    
  1402. }
  1403.